home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue66 / XMLXSLT / XSLT / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-12-13  |  5.9 KB  |  244 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   OleCtrls, SHDocVw, StdCtrls, Db, DBTables, ExtCtrls, ShellAPI;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     tblEmployee: TTable;
  12.     tblEmployeeEmpNo: TIntegerField;
  13.     tblEmployeeLastName: TStringField;
  14.     tblEmployeeFirstName: TStringField;
  15.     tblEmployeePhoneExt: TStringField;
  16.     tblEmployeeHireDate: TDateTimeField;
  17.     tblEmployeeSalary: TFloatField;
  18.     dsEmployee: TDataSource;
  19.     Button1: TButton;
  20.     Button2: TButton;
  21.     btnCreateXML: TButton;
  22.     Button4: TButton;
  23.     Button5: TButton;
  24.     mXML: TMemo;
  25.     Panel1: TPanel;
  26.     wbXML: TWebBrowser;
  27.     Button6: TButton;
  28.     procedure btnCreateXMLClick(Sender: TObject);
  29.     procedure Button1Click(Sender: TObject);
  30.     procedure Button2Click(Sender: TObject);
  31.     procedure Button5Click(Sender: TObject);
  32.     procedure Button4Click(Sender: TObject);
  33.     procedure Button6Click(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.   g_AppPath : String;
  43.  
  44. implementation
  45.  
  46. {$R *.DFM}
  47.  
  48.  
  49. procedure TForm1.btnCreateXMLClick(Sender: TObject);
  50. var f : TextFile;
  51.     i : Integer;
  52.  
  53. begin
  54.       i := 0;
  55.  
  56.       AssignFile(f, g_AppPath + '\XT\employees.xml');
  57.       Rewrite(f);
  58.       writeln(f, '<?xml version="1.0"?>');
  59.  
  60.       writeln(f, '<employees>');
  61.       writeln(f, '');
  62.  
  63.       with tblEmployee do begin
  64.         Open;
  65.         First;
  66.         DisableControls;
  67.         while not eof do begin
  68.           write(f, '<employee emp_no="');
  69.           write(f, FieldByName('EMPNO').AsString);
  70.           writeln(f, '">');
  71.  
  72.           write(f, '<emp_lastname>');
  73.           write(f, FieldByName('LASTNAME').AsString);
  74.           write(f, '</emp_lastname>');
  75.  
  76.           write(f, '<emp_firstname>');
  77.           write(f, FieldByName('FIRSTNAME').AsString);
  78.           write(f, '</emp_firstname>');
  79.  
  80.           write(f, '<emp_phoneext>');
  81.           write(f, FieldByName('PHONEEXT').AsString);
  82.           write(f, '</emp_phoneext>');
  83.  
  84.           // For every other employee, alternate the currency...
  85.           // ..for the sake of demonstration...
  86.           if i mod 2 = 0 then
  87.             write(f, '<emp_salary currency="UKP">')
  88.           else
  89.             write(f, '<emp_salary currency="USD">');
  90.  
  91.           write(f, FieldByName('Salary').AsString);
  92.           writeln(f, '</emp_salary>');
  93.  
  94.           writeln(f, '</employee>');
  95.           writeln(f, '');
  96.           next;
  97.           i:=i+1;
  98.         end;
  99.         EnableControls;
  100.         Close;
  101.       end;
  102.  
  103.       writeln(f, '</employees>');
  104.       CloseFile(f);
  105.  
  106.       mXML.Lines.LoadFromFile(g_AppPath + 'XT\employees.xml');
  107.       wbXML.Navigate(g_AppPath + 'XT\employees.xml');
  108.  
  109.       Button1.Enabled:=True;
  110.       Button2.Enabled:=True;
  111.       Button4.Enabled:=True;
  112.       Button5.Enabled:=True;
  113.       Button6.Enabled:=True;
  114.  
  115. end;
  116.  
  117.  
  118.  
  119.  
  120. function fnWinExecAndWait32(sFileName :String; iVisible :Integer):Integer;
  121. {
  122. Parameter : sFileName : Exe Filename with FullPath
  123. iVisible : Either to show the execution to the user or suppress
  124. 0 - Visible off
  125. 1 - Visible on
  126. Comment: To Execute the File and wait till the completion of the program
  127. }
  128.  
  129. var
  130.  arrAppName  :array[0..512] of char;
  131.  arrCurDir :array[0..255] of char;
  132.  sWorkDir  :String;
  133.  StartupInfo  :TStartupInfo;
  134.  ProcessInfo  :TProcessInformation;
  135.  lwResult  :LONGWORD;
  136. begin
  137.  
  138.  StrPCopy(arrAppName, sFileName);
  139.  GetDir(0, sWorkDir);
  140.  StrPCopy(arrCurDir, sWorkDir);
  141.  
  142.  FillChar(StartupInfo, sizeof(StartupInfo), #0);
  143.  StartupInfo.cb := sizeof(StartupInfo);
  144.  
  145.  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  146.  StartupInfo.wShowWindow := iVisible;
  147.  
  148.  if not CreateProcess(nil, arrAppName, nil, nil,
  149.    False, CREATE_NEW_CONSOLE OR
  150.    NORMAL_PRIORITY_CLASS, nil, nil,
  151.    StartupInfo, ProcessInfo) then
  152.   Result := -1
  153.  else
  154.  begin
  155.   WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
  156.   GetExitCodeProcess(ProcessInfo.hProcess, lwResult);
  157.   Result := 0;
  158.  end;
  159. end;
  160.  
  161.  
  162.  
  163.  
  164. procedure TForm1.Button1Click(Sender: TObject);
  165. var s : string;
  166.     sp : string;
  167. begin
  168.     mXML.Clear;
  169.  
  170.     s:=g_AppPath + 'XT\XT.EXE employees.xml ';
  171.     s:=s+ g_AppPath + 'XT\empuk.xsl ';
  172.     s:=s+ g_AppPath + 'XT\result.htm';
  173.  
  174.     fnWinExecAndWait32(s,0);  //WinExec(PChar(s), SW_SHOWMINNOACTIVE);
  175.  
  176.     wbXML.Refresh;
  177.     wbXML.Navigate(g_AppPath + 'XT\result.htm');
  178. end;
  179.  
  180. procedure TForm1.Button2Click(Sender: TObject);
  181. var s : string;
  182. begin
  183.     mXML.Clear;
  184.  
  185.     s:=g_AppPath + 'XT\XT.EXE employees.xml ';
  186.     s:=s+ g_AppPath + 'XT\empus.xsl ';
  187.     s:=s+ g_AppPath + 'XT\result.htm';
  188.  
  189.     fnWinExecAndWait32(s,0);  //WinExec(PChar(s), SW_SHOWMINNOACTIVE);
  190.  
  191.     wbXML.Refresh;
  192.     wbXML.Navigate(g_AppPath + 'XT\result.htm');
  193. end;
  194.  
  195. procedure TForm1.Button5Click(Sender: TObject);
  196. var s : string;
  197. begin
  198.     mXML.Clear;
  199.  
  200.     s:=g_AppPath + 'XT\XT.EXE employees.xml ';
  201.     s:=s+ g_AppPath + 'XT\empussal.xsl ';
  202.     s:=s+ g_AppPath + 'XT\result.htm';
  203.  
  204.     fnWinExecAndWait32(s,0);  //WinExec(PChar(s), SW_SHOWMINNOACTIVE);
  205.  
  206.     wbXML.Refresh;
  207.     wbXML.Navigate(g_AppPath + 'XT\result.htm');
  208. end;
  209.  
  210. procedure TForm1.Button4Click(Sender: TObject);
  211. var s : string;
  212. begin
  213.     mXML.Clear;
  214.  
  215.     s:=g_AppPath + 'XT\XT.EXE employees.xml ';
  216.     s:=s+ g_AppPath + 'XT\empuksna.xsl ';
  217.     s:=s+ g_AppPath + 'XT\result.htm';
  218.  
  219.     fnWinExecAndWait32(s,0);  //WinExec(PChar(s), SW_SHOWMINNOACTIVE);
  220.  
  221.     wbXML.Refresh;
  222.     wbXML.Navigate(g_AppPath + 'XT\result.htm');
  223. end;
  224.  
  225. procedure TForm1.Button6Click(Sender: TObject);
  226. var s : string;
  227. begin
  228.     mXML.Clear;
  229.  
  230.     s:=g_AppPath + 'XT\XT.EXE employees.xml ';
  231.     s:=s+ g_AppPath + 'XT\empuksnd.xsl ';
  232.     s:=s+ g_AppPath + 'XT\result.htm';
  233.  
  234.     fnWinExecAndWait32(s,0);  //WinExec(PChar(s), SW_SHOWMINNOACTIVE);
  235.  
  236.     wbXML.Refresh;
  237.     wbXML.Navigate(g_AppPath + 'XT\result.htm');
  238. end;
  239.  
  240. initialization
  241.      g_AppPath:=ExtractFilePath(Application.ExeName);
  242.  
  243. end.
  244.